package CleverBotWeb;
use strict;
use CGI qw/:standard/;
use CGI::Carp qw/fatalsToBrowser/;
use Data::Dumper;
#use POSIX qw/strftime/;
use lib '.';
use CleverBot;
use Encode;

sub new{
 my $pkg = shift;
 my $cgi = new CGI;
 my $p = $cgi->Vars;

 my $user_ip = $ENV{REMOTE_ADDR}||$ENV{HTTP_X_FORWARDED_FOR};
 ($user_ip) = $user_ip =~ /(\d{1,3}\.\d{1,3}\.\d{1,3}\.\d{1,3})/;
 $user_ip ||="";
 # $user_ip='';
 die "YOUR IP ADDRESS IS EMPTY! Try connect to this application without proxy server. Sorry. " if !$user_ip;
 my $self = { 
    cb 	=> CleverBot->new(), #CleverBot object 
    cgi => $cgi,
    p 	=> $p,
    user_ip => $user_ip,
#    db => undef, 
#    dbh => undef,
#    debug_call => 0,
 };

# die Dumper $self;
 return bless $self;
}

sub error { shift->{error} }

sub answer{
 my $self = shift;
 my $rv;
 
 $rv = $self->handle_actions( );
 return $rv;
}



sub headers{
 my $self = shift;
 my %pars = @_;
 $pars{no_debug}+=0;
 my $rv;
 $rv .= header(-charset=>'UTF-8');
 #die Dumper $self->{cb};
 $rv .= start_html(
     -title=>$self->{cb}{conf}{html_title},
     -style=>{ 'src'=>$self->{cb}{conf}{html_style_src} },     
    # -BGCOLOR=>'lightgray' # set in .scc file instead
 );
 my $dumper = Dumper($self);
# $dumper =~s/\n/<BR>/gs;
 $rv .= $dumper if $self->{cb}{conf}{html_show_debug} && !$pars{no_debug};
 return $rv;
}

# NOTE: CGI-parameters:
# nr = "not_readed somebody"
# nt = "not_taken somebody"
# nj = "not_rejected somebody"
# nrm = "not_readed by me"
# ntm = "not_taken by me"
# njm = "not_rejected by me"
# bf = "base_filter"
# t = taked somebody
# r = readed somebody
# j = rejected somebody
# tm = taked by my
# rm = readed by my
# jm = rejected by my

sub url{
 my $self = shift;
 my %pars = @_;
 my $rv = "?";
 my @rv;
 for ( keys( %pars ) ){
    next if $_ eq "default";
    my $push = $_."=".( defined $pars{$_} ? $pars{$_} : $self->{p}{$_} );
    push @rv , $push ;
 } 
 
 my @def;
 @def = @{ $pars{default} } if ref $pars{default} eq "ARRAY";
 push @rv , "$_=$self->{p}{$_}" for @def;
 
 $rv = $rv.join( '&', @rv );
# die Dumper $self->{p};
}

sub menu_builder{
 # internal method
 # Usage: my $html_table = $self->menu_builder( menu=>\@menu )
 # ,where @menu - structure like this:
 # my @menu = (
 #     { t=>"Название 1", u=>url(), par=>{ screen=>"list", action=>"look", nrm=>0, nt=>0, bf=>0, jm=>1, j=>1 }, imp=>{jm=>1} },
 #     { t=>"Назв 2.", u=>url(), par=>{ screen=>"list", action=>"look", nrm=>0, nt=>0, bf=>0, rm=>1, j=>1 }, imp=>{rm=>1} },
 # );
                      
 my $self = shift;
 my %pa = @_;
 my @menu;
 @menu = @{ $pa{menu} } if ref $pa{menu} eq "ARRAY";
 @menu or die "\@menu!";
 
 my $rv;
 my %cl = (-class=>"menu");
 
 for my $item ( @menu ){
    my $u = $item->{u};
    my $t = $item->{t};
    my %par = %{ $item->{par} };
    my $pars = join '&', map { "$_=$par{$_}"  }( keys %par );
    
    my %imp;
    %imp = %{ $item->{imp} } if ref $item->{imp} eq "HASH";
    
    # is current item or not:
    my $current = 1;
    for ( keys %imp ){
	$current = 0 if $imp{$_} ne $self->{p}->{$_};
#	die Dumper $par{$_} , $self->{p}->{$_};
    }
    my %cl1;
    if ($current){
	%cl1 = ( -class=>join(" ",values(%cl),"current") );
    }else{
	%cl1 = %cl;
    }	
    $rv .= td( { %cl1 }, a({ %cl1, -href=>"$u"."$pars"}, "$t") );
 }
 
 $rv = table({ %cl }, Tr({ %cl },$rv) );
}

sub menu{
 my $self = shift;
 my $rv;
 my %p = %{ $self->{p} };
 # structure of menu:
 # t - title(text) of hiperlink
 # u - url of hiperlink
 # par=>{...} - cgi-parameters, will joined to end of url
 # imp=>{...} - important for compare to determine "is current this item or not?" at that time
 my ( $yn, $mn ) = $self->{cb}->my_date;
 my ( $yl_mf, $yl_yf )= $self->{cb}->mon_incr( $mn, $self->{y_to}, $self->{cb}{conf}{old_year_diapasone_from}-12 );
 my ( $yl_mt, $yl_yt )= $self->{cb}->mon_incr( $mn, $self->{y_to}, $self->{cb}{conf}{old_year_diapasone_to}-12 );
 
 my @menu = (
    { t=>"Конкурсы.", u=>url(), par=>{ screen=>"list", action=>"look",  }, imp=>{ screen=>"list", action=>"look", } },
    { t=>"Прочитанные мной.", u=>url(), par=>{ screen=>"list", action=>"look", nrm=>0, nt=>0, bf=>0, rm=>1, j=>1 }, imp=>{rm=>1} },        
    { t=>"Принятые мной.", u=>url(), par=>{ screen=>"list", action=>"look", nrm=>0, nt=>0, bf=>0, tm=>1 , j=>1 }, imp=>{tm=>1} },    
    { t=>"Сброшенные мной.", u=>url(), par=>{ screen=>"list", action=>"look", nrm=>0, nt=>0, bf=>0, jm=>1, j=>1 }, imp=>{jm=>1} },
    { t=>"Принятые.", u=>url(), par=>{ screen=>"list", action=>"look", nrm=>0, nt=>0, bf=>0, t=>1 , j=>0 }, imp=>{t=>1} },
#    { t=>"Прочитанные.", u=>url(), par=>{ screen=>"list", action=>"look", nrm=>0, nt=>0, bf=>0, r=>1, j=>0 }, imp=>{r=>1} }, # никому не интересно
    { t=>"Год назад.", u=>url(), par=>{ 
	    screen=>"list", action=>"look", myf=>"$yl_mf/$yl_yf", myt=>"$yl_mt/$yl_yt" ,
	    nr=>$p{nr}, nrm=>$p{nrm}, nt=>$p{nt}, ntm=>$p{ntm}, r=>$p{r}, rm=>$p{rm}, t=>$p{t}, tm=>$p{tm}, j=>$p{j}, bf=>$p{bf}, 
	}, 
	imp=>{ screen=>"list", action=>"look", myf=>"$yl_mf/$yl_yf"} 
    },
    { t=>"Все.", u=>url(), par=>{ screen=>"list", action=>"look", nrm=>0, nt=>0, bf=>0, jm=>0, j=>1 }, imp=>{j=>1, jm=>0} },    
    { t=>"Сервис.", u=>url(), par=>{ screen=>"service", action=>"stat",  }, imp=>{ screen=>"service" } },
    { t=>"Справка.", u=>url(), par=>{ screen=>"userdoc", action=>"content",  }, imp=>{ screen=>"userdoc" } },
    
 );
 
 my %cl = (-class=>"menu");
 return $self->menu_builder( menu=>\@menu );
}

sub list_menu{
 my $self = shift;
 my %p = %{ $self->{p} };
 my %op; # options
 @op{$_} = 1 for qw/ screen action rm tm jm r t nr nt nrm j bf myf myt ok /;
 map { $op{$_} =0 } qw/ nr nrm nt / if $p{rm};
 map { $op{$_} =0 } qw/ nr nrm nt / if $p{tm};
 map { $op{$_} =0 } qw/ nr nrm nt j/ if $p{jm}; 
 map { $op{$_} =0 } qw/ nr nt / if $p{t};  
 
# die Dumper \%opt;
 my $rv; my $t; my $tr; my %cl;
 my %clnc = (-class=>"menu");
 my %clc = (-class=>"menu current");
 my $td1; 
 $td1 .= hidden("screen",$self->{p}{screen} );
 $td1 .= hidden("action",$self->{p}{action} );
 $td1 .= hidden("rm",$self->{p}{rm} );
 $td1 .= hidden("tm",$self->{p}{tm} );
 $td1 .= hidden("jm",$self->{p}{jm} );
 $td1 .= hidden("r",$self->{p}{r} );
 $td1 .= hidden("t",$self->{p}{t} );
 $td1 .= hidden("nr",$self->{p}{nr} ) if !$op{nr};
 $td1 .= hidden("nrm",$self->{p}{nrm} ) if !$op{nrm};
 $td1 .= hidden("nt",$self->{p}{nt} ) if !$op{nt};
 $td1 .= hidden("j",$self->{p}{j} ) if !$op{j};
 
 !$self->{p}{nr} ? (%cl = (-class=>"menu")) : (%cl = %clc);
 $td1 .= checkbox(-name=>"nr",-checked=>$self->{p}{nr},-value=>1,-label=>"Не прочитанные никем", ) if $op{nr};
 
 $td1 = td({%cl}, $td1 );
 $tr .= $td1;

 !$self->{p}{nt} ? (%cl = (-class=>"menu")) : (%cl = %clc);
 $tr .= td({%cl}, checkbox(-name=>"nt", -checked=>$self->{p}{nt}, -value=>1,-label=>"Не принятые никем", ))  if $op{nt};

 !$self->{p}{nrm} ? (%cl = (-class=>"menu")) : (%cl = %clc);
 $tr .= td({%cl}, checkbox(-name=>"nrm",-checked=>$self->{p}{nrm},-value=>1,-label=>"Не прочитанные мной",  )) if $op{nrm};

 !$self->{p}{j} ? (%cl = (-class=>"menu")) : (%cl = %clc);
 $tr .= td({%cl}, checkbox(-name=> "j", -checked=>$self->{p}{j},  -value=>1,-label=> "даже сброшенные", )) if $op{j};

 %cl = %clnc;
 $tr .= td({%cl}, label( "Фильтр:", textfield(%cl,-name=>"bf",-default=>$self->{p}{bf} ) ) );
 
 !$self->{p}{zf} ? (%cl = (-class=>"menu")) : (%cl = %clc);
 $tr .= td({%cl}, label( "Заказчик:", textfield(%cl,-name=>"zf",-default=>$self->{p}{zf} ) ) );
 
 %cl = %clnc;
 
 $tr .= td({%cl}, label( "C:", textfield(%cl,-name=>"myf",-default=>"$self->{m_from}/$self->{y_from}", -override=>1, -size=>7, -maxlength=>7 ) ) );

 $tr .= td({%cl}, label( "ПО:", textfield(%cl,-name=>"myt",-default=>"$self->{m_to}/$self->{y_to}", -override=>1, -size=>7, -maxlength=>7 ) ) );

 $tr .= td({%cl}, submit(%cl, -name=>"Ok") );

 $tr = Tr( start_form() . $tr . end_form() );
 $t = table( {-border=>0,}, $tr );
 $rv = $t;
 return $rv;
}


sub handle_actions{
 my $self = shift;
 
 my $ip_addr_regexp = $self->{cb}->conf("ip_addr_regexp");
 if ( $ip_addr_regexp and $self->{user_ip} !~/$ip_addr_regexp/i ){
    return $self->headers()."Ваш ip-адрес!";
 }
 
 my $zfnid = $self->{p}{zfnid}+=0; # z-filter news id
 my $sql = "SELECT * FROM news WHERE news_id=$zfnid";
 my $sth = $self->{cb}->find( sql => $sql ) or die $self->{cb}->error;
 my $one_rec = $sth->fetchrow_hashref();
# die Dumper $one_rec;
 if ( $one_rec  ){
    if ( my $cu = $one_rec->{ customer } ){
	my $zf = $cu;
	$self->{p}{zf} = $zf;
    }
 }
 
 # SET: default CGI-pars:
# $self->{cgi}->param("nr", 1); # <- всегда в выборку должны попадать "не прочитанные никем", а checkbox-только для демонстрации
 if ( !defined $self->{p}{bf} or $self->{p}{bf} == 1 ){
    $self->{cgi}->param("bf", $self->{cb}->conf("base_filter_regexp"));
 }    

 # convert diapasone to our format:
 ( $self->{m_from}, $self->{y_from} ) = $self->{p}{myf} =~ /(\d{1,2})\D(\d{4})/;
 ( $self->{m_to},   $self->{y_to}   ) = $self->{p}{myt} =~ /(\d{1,2})\D(\d{4})/;

 # if user enter incorrect or empty diapasone, use defaults: 
 
 if ( !$self->{m_from} or !$self->{y_from} or !$self->{m_to} or !$self->{y_to} ){
#    my $cdlen = $self->{cb}{conf}{"current_diapasone_len"}||2; # in conf: "12" - count of month
    my ( $yn, $mn ) = $self->{cb}->my_date(); # now_mon and now_year
    my ( $m_to, $y_to ) = ( $mn, $yn );
    my ( $m_from, $y_from ) = $self->{cb}->mon_incr( $mn, $yn, + ($self->{cb}{conf}{"current_diapasone_from"}||-2) ); # - decrease on $cdlen 

    $self->{m_from} ||= $m_from;
    $self->{y_from} ||= $y_from;
    $self->{m_to}   ||= $m_to;
    $self->{y_to}   ||= $y_to;
 }
 $self->{m_from} = sprintf("%02d",$self->{m_from});
 $self->{m_to} = sprintf("%02d",$self->{m_to});
 
 # когда сняты галочки, то они не 0, а совсем неопределены, 
 #нельзя делать так:
 #$self->{cgi}->param("nrm", 1 ) if !defined $self->{p}{nrm}; 
 
 #update $p hashref after change pars:
 $self->{p} = $self->{cgi}->Vars;
 # die Dumper $self->{p}; 
 
 my $rv;
 my $screen = $self->{p}->{screen};
 my $action = $self->{p}->{action};

 #-------------- 'list' / '' screen: --------------------
 if ( $screen eq "list" or $screen eq ""){
	#my $list_menu = $self->list_menu;
	
	    # ----------- 'look' action: ---------
	    if ( $action eq "look"  ){
		return $self->pack_look();
	    }
	    # ---------- 'set_taked_me' action: ------
	    elsif ( $action eq "set_taked_me"  ){
		$rv = $self->set_taked_me();
		#print $self->headers().$self->menu().$self->list_menu().$rv;
		return redirect $self->url( action=>"look", default=>[qw/ screen nr nt nrm j bf zfnid rm tm jm r t myf myt /] );
	    }	    

	    # ---------- 'set_untaked' action: ------
	    elsif ( $action eq "set_untaked"  ){
		$rv = $self->set_untaked();
		#print $self->headers().$self->menu().$self->list_menu().$rv;
		return redirect $self->url( action=>"look", default=>[qw/ screen nr nt nrm j bf zfnid rm tm jm r t myf myt /] );
	    }	    	    

	    # ---------- 'set_rejected_me' action: ------
	    elsif ( $action eq "set_rejected_me"  ){
		$rv = $self->set_rejected_me();
		#print $self->headers().$self->menu().$self->list_menu().$rv;
		return redirect $self->url( action=>"look", default=>[qw/ screen nr nt nrm j bf zfnid rm tm jm r t myf myt /] );
	    }	    

	    # ---------- 'set_unrejected' action: ------
	    elsif ( $action eq "set_unrejected"  ){
		$rv = $self->set_unrejected();
		#print $self->headers().$self->menu().$self->list_menu().$rv;
		return redirect $self->url( action=>"look", default=>[qw/ screen nr nt nrm j bf zfnid rm tm jm r t myf myt /] );
	    }	    

	    # ---------- 'read_news' action: ------
	    elsif ( $action eq "read_news"  ){
		$rv = $self->set_readed_me();
		my $news_url = $self->news_url() or die "news_url!";
		return redirect $news_url;
	    }	    

	    # ---------- 'set_readed_me' action: ------
	    elsif ( $action eq "set_readed_me"  ){
		$rv = $self->set_readed_me();
		#print $self->headers().$self->menu().$self->list_menu().$rv;
		return redirect $self->url( action=>"look", default=>[qw/ screen nr nt nrm j bf zfnid rm tm jm r t myf myt /] );
	    }	    

	    # ---------- 'set_unreaded_me' action: ------
	    elsif ( $action eq "set_unreaded_me"  ){
		$rv = $self->set_unreaded_me();
		#print $self->headers().$self->menu().$self->list_menu().$rv;
		return redirect $self->url( action=>"look", default=>[qw/ screen nr nt nrm j bf zfnid rm tm jm r t myf myt /] );
	    }	    

	    else{
	    # ------------- other/default action: --------
		return $self->pack_look();
	    }
	
 } # -end of "list" screen

 #----------------- 'service' screen ---------------
 elsif ( $screen eq "service" ){
	    # ----------- '' action: ---------
	    if ( $action eq "stat"  ){
		$rv = $self->view_stat();
		return $self->headers().$self->menu().$self->service_menu().$rv;
	    }    
	    elsif( $action eq "launch_scan" ){
		$rv = $self->launch_scan();
		return $self->headers().$self->menu().$self->service_menu().$rv;
	    }
	    elsif( $action eq "delete_old" ){
		$rv = $self->delete_old( only_get_mon=>$self->{p}{only_get_mon}, only_get_records=>$self->{p}{only_get_records}, html=>1 );
		return $self->headers().$self->menu().$self->service_menu().$rv;
	    }	    
	    else{
	    # ------------- other/default action: --------
		$rv = $self->view_stat();# default sub
		return $self->headers().$self->menu().$self->service_menu().$rv;
	    }	    
 } 

 elsif ( $screen eq "userdoc" ){
     my $img = $self->{p}{img};
     my $header;
    if ( $img ){
	return header('image/gif').$self->userdoc( action=>"$action" );
    }
    else{
	return $self->headers().$self->menu().$self->userdoc( action=>"$action" );
    }
 }
 
 #------------------ other / default screen ----------------
 else{
    return $self->pack_look();
 } 

}

sub pack_look{
 my $self = shift;
 my $format = lc $self->{p}{format};
 my $rv = $self->look( format => $format, );
 if ( $format eq "csv"){
    return $self->headers( no_debug=>1 ).$rv;
 }else{
    my $src = $self->{cb}{conf}{logo};
    $src =~s/(^\s+)|(\s+$)//g;
    my $logo;
    $logo = img({src=>"$src",align=>'LEFT'}) if $src;
    return $self->headers().
    table({-border=>0},
	Tr(
	    td( {-rowspan=>2}, $logo ), td( $self->menu() ),
	),
	Tr(
	    td( $self->list_menu() ),
	),
    )
    .$rv;
 }    
}

sub look{
 my $self = shift;
 my %pars = @_;
 my %counters = ( count => 0,);
 
 if ( $pars{format} eq "csv" and ( $self->{p}->{count} eq '0' or $self->{p}->{count}>0 ) ){
 # в запросах нужно иметь возможность явно указать сколько хочешь получить. Это нужно для проверки - работает/нет.
 # при этом не нужны лишние действия, только вернуть нужное 'count'.
    $counters{count} = $self->{p}->{count}; 
    my $rv = $self->return_counters(\%counters);
    return $rv;
 }
 
 my @and_where; my @or_where;
 push @or_where , "nir.id is null" if $self->{p}->{nr};; # не прочитанные никем 
 push @or_where , "who_take =''" if $self->{p}->{nt}; # не принятые никем
 if ( $self->{p}->{nrm} ){
    if ( $self->{p}->{nr} ){
	#(не прочитанные никем уже указано)
	push @or_where , "nir.ip != ''" if $self->{p}->{nrm}; # прочитанные кем-нибудь (ниже в цикле будет дополнительный фильтр), 
    }
    else{
	push @or_where , "nir.ip != ''" if $self->{p}->{nrm}; # прочитанные кем-нибудь

	push @or_where , "nir.id is null"; # а также непроитанные никем
    }
 }
 if ( $self->{p}->{j} ){
     # даже сброшенные кем либо
 }
 else{
    push @and_where , "who_reject =''" ; # не сброшенные кем либо
 }
 
 my ($mt, $yt) = $self->{cb}->mon_incr( $self->{m_to}, $self->{y_to}, +1 );
 $mt = sprintf("%02d",$mt);
# my ($mt, $yt) = ($self->{m_to}, $self->{y_to});
 push @and_where, "(datetime>=$self->{y_from}$self->{m_from}01000000 AND datetime<$yt$mt"."01000000)";
# die Dumper \@and_where;
 
 push @and_where , "who_take ='$self->{user_ip}'" if $self->{p}->{tm};
 push @and_where , "who_take !=''" if $self->{p}->{t};
 push @and_where , "who_reject ='$self->{user_ip}'" if $self->{p}->{jm};
 push @and_where , "nir.ip ='$self->{user_ip}'" if $self->{p}->{rm};
 push @and_where , "nir.ip is not null" if $self->{p}->{r};
 
 # $self->{p}->{base_filter} will use later, see below
 
# die Dumper $self->{p}; # Show cgi-parameters in browser
 
 my $or_where = join(" OR ", @or_where);
 my $and_where = join(" AND ", @and_where);
 my $or_where = "( $or_where )" if $or_where;
 my $where = $or_where && $and_where ? join " AND ", $or_where, $and_where
    : $or_where||$and_where;
 $where = " WHERE $where " if $where;
 my $cb = $self->{cb} or die "cb!";
 my $sql = "SELECT n.*, 
	nir.id AS nir_id,
	nir.ip AS nir_ip,
	i.*
    FROM news n 
    LEFT JOIN news_ips_read nir ON n.news_id = nir.news_id
    LEFT JOIN ips i ON nir.ip = i.ip
    $where
    ";
# die Dumper $sql;
 my $sth = $cb->find( sql => $sql ) or die $cb->error;
 $cb->{look_sql} = $sql;
 my $rv; my $t; 

 my %out;
 while ( my $r = $sth->fetchrow_hashref() ){
    #die Dumper $r; #- view structure in browser
    # bf - Base Filter:
    if ( $self->{p}->{bf} ){
	my $bf = decode_utf8( $self->{p}->{bf} );
	my $st = decode_utf8( $r->{small_text} );
	next if $st !~/$bf/i;

    }

    # zf - Zakazchik Filter:
    if ( $self->{p}->{zf} ){
	my $zf = decode_utf8( $self->{p}->{zf} );
	my $cu = decode_utf8( $r->{customer} );
	next if $cu !~/$zf/i;
    }	
    
    my $dt = $r->{datetime};
    my ( $y, $m, $d, $h, $mi, $s) = $cb->my_date( $dt );
    $out{ $y }{ $m }{ $d }{ "$h$mi$s" }{ $r->{news_id} }{ n } = $r;
    $out{ $y }{ $m }{ $d }{ "$h$mi$s" }{ $r->{news_id} }{ nir }{ $r->{nir_id} } = { 
	ip => $r->{nir_ip},
#	datetime => $r->{nir_datetime}, 
	name_en => $r->{name_en},
	name_ru => $r->{name_ru},
    } if $r->{nir_id};
 }
 #die Dumper \%out; #- view structure in browser
 
 my $sth2 = $cb->find( sql => "SELECT ip, name_en, name_ru FROM ips" ) or die $cb->error;
 my %name_en_ru;
 while ( my ($ip, $en, $ru) = $sth2->fetchrow_array ){
    $name_en_ru{ $ip } = { en=>$en, ru=>$ru };
 }
 #die Dumper \%name_en_ru; #- display 
 
 
 
 for my $y ( sort {$b<=>$a} keys %out ){
    #$t .= Tr(td({-class=>"group"},"$y")); # выводить год в отдельной строчке над месяцем
    for my $m ( sort {$b<=>$a} keys %{ $out{$y} } ){
	$t .= Tr( td( {-class=>"th"}, ["Дата / Время","Сайт","Заказчик","Ссылка","Прочитан","Принят","Сброшен"] ) );# table header 
    	$t .= Tr(td({-class=>"group", -colspan=>1},"$m / $y"));
	for my $d ( sort {$b<=>$a} keys %{ $out{$y}{$m} } ){
	    my %cl = (-class=>"group");
	    $t .= Tr(td({%cl, -colspan=>7},"$d.$m.$y"));# -date
	    
	    for my $hmis ( sort {$b<=>$a} keys %{ $out{$y}{$m}{$d} } ){
		#$t .= Tr(td({-class=>"group"},"Время: $hmis"));
		my $time = join ':', $hmis=~/(\d\d)(\d\d)\d\d/;
		
		for my $news_id ( sort {$a<=>$b} keys %{ $out{$y}{$m}{$d}{$hmis} } ){
		    # available vars for use:
		    # $y = year; $m = mon; $d = day 
		    # $hmis = time in hhmmss format 
		    # $news_id = news.news_id
		    # $r = full current record (hash_ref)
		    
		    
		    my $r = $out{ $y }{ $m }{ $d }{ $hmis }{ $news_id }{n};
		    my %r = %$r;
		    #$t .= Tr( td( [ $time, @r{qw/ site id url small_text who_take datetime/}, ] ) );
		    my $an;
		    if ( $cb->{conf}{ set_readed_before_open_news } ){ # automaticaly 'set readed' on click
			my $url = $self->url( action=>"read_news", news_id=>$news_id, default=>[qw/ screen nr nt nrm j bf rm tm jm r t /] );
			$an = a({-href=>$url, -target=>$url},$r{small_text});
		    }else{	
		        
			$an = a({-href=>"$r{site}/$r{url}" , -target=>"$r{site}/$r{url}"}, $r{small_text});
			#my $news_url = $self->news_url() or die "news_url!";
			#$an = a({-href=>$news_url , -target=>$news_url,}, $r{small_text});
		    }	
		    
		    my $site_an_text = $r{site};
		    $site_an_text =~ s/http\:\/\///;
		    $site_an_text =~ s/www\.//;
		    my $site_an = a({-href=>$r{site},-target=>$r{site}}, $site_an_text );
		    
		    my $customer_an = a({-href=>$self->url( zfnid=>$news_id, default=>[qw/action screen nr nt nrm j bf rm tm jm r t myf myt /] )},$r{customer});
		    
		    my $nir_href = $out{ $y }{ $m }{ $d }{ $hmis }{ $news_id }{nir};
		    my %nir;
		    %nir = %$nir_href if ref $nir_href eq "HASH";
		    
		    my @readed;
    		    push @readed, $nir{$_}{name_ru}||$nir{$_}{name_en}||$nir{$_}{ip} for keys %nir;
		    #die Dumper \%nir, \@readed if $r{news_id}==75;
    		    my %was_read = map { $nir{$_}{ip} => 1 } keys %nir;
    		    #die Dumper %was_read if %was_read;

		    if ( $self->{p}->{nrm} and $was_read{ $self->{user_ip} } ){
			#не показывать записи, прочитаннын мной:
			#die Dumper \%was_read;
			next;
		    }

		    $counters{count} ++; # счетчик должен стоять после всех возможных "next" (не подимать выше, при появлении новых "next" - опустить ниже)
		    

		    my $set_rm_an = a(
			{-href=>$self->url( action=>"set_readed_me", news_id=>$news_id, default=>[qw/ screen nr nt nrm j bf zfnid rm tm jm r t myf myt /] ) }, 
			"Пометить_'Прочитано'" );
		    my $set_urm_an = a(
			{-href=>$self->url( action=>"set_unreaded_me", news_id=>$news_id, default=>[qw/ screen nr nt nrm j bf zfnid rm tm jm r t myf myt /] ) }, 
			"Пометить_'Непрочитано'" );
		    my $set_tm_an = a(
			{-href=>$self->url( action=>"set_taked_me", news_id=>$news_id, default=>[qw/ screen nr nt nrm j bf zfnid rm tm jm r t myf myt /] ) }, 
			"Принять" );
		    my $set_ut_an = a(
			{-href=>$self->url( action=>"set_untaked", news_id=>$news_id, default=>[qw/ screen nr nt nrm j bf zfnid rm tm jm r t myf myt /] ) }, 
			"Отказаться" );
		    my $set_jm_an = a(
			{-href=>$self->url( action=>"set_rejected_me", news_id=>$news_id, default=>[qw/ screen nr nt nrm j bf zfnid rm tm jm r t myf myt /] ) }, 
			"Сбросить" );
		    my $set_uj_an = a(
			{-href=>$self->url( action=>"set_unrejected", news_id=>$news_id, default=>[qw/ screen nr nt nrm j bf zfnid rm tm jm r t myf myt /] )  }, 
			"Восстановить" );
		    # columns:
		    $t .= Tr( td( [ 
			    $time, 
			    $site_an,
			    $customer_an,
			    $an , 
			    
			    
			    # "прочитан":
			    join(', ',@readed)." "
			    .( 
				$was_read{ $self->{user_ip} } ?
			        $set_urm_an : 	# Пометить "непрочитанный"
			        $set_rm_an	# Пометить "Прочитано"
			     ),
			#    ($r{news_id}==75 ? die( Dumper $r, \@readed):""),
			    # "принят":
			    (
				$name_en_ru{ $r{who_take} }{ru}||$name_en_ru{ $r{who_take} }{en}||$r{who_take}
			    )." "
			    .(
				$r{who_take} eq $self->{user_ip} ?
				$set_ut_an : 	# "отказаться"
				$r{who_take} ?
				"" :
				$set_tm_an	# "принять"
			    ),
			    
			    # "сброшен":
			    (
				$name_en_ru{ $r{who_reject} }{ru}||$name_en_ru{ $r{who_reject} }{en}||$r{who_reject}
			    )." "
			    .(
#				$r{who_reject}  eq $self->{user_ip} ?
#				    $set_uj_an  : 	# "восстановить"
				    $r{who_reject} ?
					"$set_uj_an" :
					# если принят, то сбросить нельзя:
					$r{who_take} ?
					    "" :
					    $set_jm_an 	# "сбросить"
			    ),
			    
			] ) );
		}    
	    }	
	}
    }
 }
 $t = table({-border=>0}, $t );
 $rv = $t;
 
 if ( $pars{format} eq "csv" ){
    $rv = $self->return_counters(\%counters);
    #$rv .= "This page in csv format. Open 'view page source' to see all tags. In data block key=value pairs separated by ';'.";
 }
 return $rv;
}

sub return_counters{
 my $self = shift;
 my $counters_ref = shift or die "couners_ref!";
 my %counters = %$counters_ref; 
 my $rv;
 $rv = "BEGIN<CSV>".join( ";", map {"$_=$counters{$_}"} keys %counters )."</CSV>END";
 return $rv;
}

sub set_taked_me{
 my $self = shift;
 $self->set_readed_me(); # принят=прочитан
 my $news_id = $self->{p}{news_id} or  die "CGI-param news_id most be defined! \nCGI params: ".Dumper($self->{p});
 $self->{cb}->do_sql( sql=>"UPDATE news SET who_take=? WHERE news_id=?", attrib=>undef, bind_values=>[$self->{user_ip}, $news_id] );
 #die Dumper $self->{cb}->db()->{sql};
 # В процедурах set_... 'exit' не делать! Они вызываются вложенно.
}

sub set_untaked{
 my $self = shift;
 my $news_id = $self->{p}{news_id} or  die "CGI-param news_id most be defined! \nCGI params: ".Dumper($self->{p});
 $self->{cb}->do_sql( sql=>"UPDATE news SET who_take=? WHERE news_id=?", bind_values=>['', $news_id] );
 
}

sub set_rejected_me{
 my $self = shift;
 $self->set_readed_me(); # сброшен=прочитан
 my $news_id = $self->{p}{news_id} or  die "CGI-param news_id most be defined! \nCGI params: ".Dumper($self->{p});
 $self->{cb}->do_sql( sql=>"UPDATE news SET who_reject=? WHERE news_id=?", attrib=>undef, bind_values=>[$self->{user_ip}, $news_id] );
 
}

sub set_unrejected{
 my $self = shift;
 my $news_id = $self->{p}{news_id} or  die "CGI-param news_id most be defined! \nCGI params: ".Dumper($self->{p});
 $self->{cb}->do_sql( sql=>"UPDATE news SET who_reject=? WHERE news_id=?", bind_values=>['', $news_id] );
 
}

sub set_readed_me{
 my $self = shift;
 my $news_id = $self->{p}{news_id}+=0 or  die "CGI-param news_id most be defined! \nCGI params: ".Dumper($self->{p});
 # проверить отсутствие записи:
 
 my $sql1 = "DELETE FROM news_ips_read WHERE ip = ? AND news_id = ?";
 $self->{cb}->do_sql( sql=>$sql1, bind_values=>[ $self->{user_ip}, $news_id ] );
 
 my $sql2 = "INSERT INTO news_ips_read (ip, news_id) VALUES (?,?)";
 $self->{cb}->do_sql( sql=>$sql2, bind_values=>[ $self->{user_ip}, $news_id ] );
 
}

sub set_unreaded_me{
 my $self = shift;
 my $news_id = $self->{p}{news_id}+=0 or  die "CGI-param news_id most be defined! \nCGI params: ".Dumper($self->{p});
 # проверить отсутствие записи:
 
 my $sql1 = "DELETE FROM news_ips_read WHERE ip = ? AND news_id = ?";
 $self->{cb}->do_sql( sql=>$sql1, bind_values=>[ $self->{user_ip}, $news_id ] );
 
 
}

sub service_menu{
 my $self = shift;
 my $rv;
 # structure of menu:
 # t - title(text) of hiperlink
 # u - url of hiperlink
 # par=>{...} - cgi-parameters, will joined to end of url
 # imp=>{...} - important for compare to determine "is current this item or not?" at that time
 
 my @menu = (
    { t=>"Статистика", u=>url(), par=>{ screen=>"service", action=>"stat"} , imp=>{action=>"stat"} },
    { t=>"Запустить сканирование!", u=>url(), par=>{ screen=>"service", action=>"launch_scan",  }, imp=>{ screen=>"service", action=>"launch_scan" } },
    { t=>"Очистка БД...", u=>url(), par=>{ screen=>"service", action=>"delete_old", only_get_mon=>1 }, imp=>{ screen=>"service", action=>"delete_old" } },
    
 );
 return $self->menu_builder( menu=>\@menu );

} 


sub view_stat{
 my $self = shift;
 my $rv; 
 # ip:
 $rv .= table({-border=>0},Tr( td("Ваш IP-адрес:"),td("$self->{user_ip}") ) );

 # scan process:
 my $pid = $self->{cb}->i_am_running( lock=>$self->{cb}->conf("lock_file"), set_lock=>0 );
 $rv .= table({-border=>0},Tr( td("Процесс сканирования в данный момент:"),td( $pid ? "идет: PID=$pid" : "не идет." ) ) ); 

 # stat:
 my $t;
 my $sth = $self->{cb}->find( table=>"stat", where=>"", order_by=>"name_en" );
 $t.= Tr(td([ "English", "Русский", "Значение", "Комментарий / Текст ошибки", "Дата/время" ]));
 
 while ( my $r = $sth->fetchrow_hashref ){
    my %r = %$r;
    my $success = $r{val} eq 1 ? "Успешно" : $r{val} eq "0" ? "Не успешно" : $r{val} ;
    $success = "Не успешно" if $r{val} eq "";
    my ($y,$m,$d,$h,$mi,$s) = $self->{cb}->my_date( $r{datetime} ) if $r{datetime};
    $t .= Tr(td([ @r{qw/ name_en name_ru /}, $success, $r{comment}, "$d.$m.$y $h:$mi" ]));
 }
 $t = table({-border=>1}, $t);
 $rv .= $t;
 

 

 return $rv;
}

sub launch_scan{
 my $self = shift;
 my $rv;
 #>> Проверяет, запущен ли в данный момент процесс сканирования
 my $pid = $self->{cb}->i_am_running( lock=>$self->{cb}->conf("lock_file"), set_lock=>0 );
 
 if ( $pid ){
    #>> Если да, то отображает PID процесса.
    $rv .= table({-border=>0},Tr( td("Процесс сканирования в данный момент:"),td( $pid ? "идет: PID=$pid" : "не идет." ) ) ); 
 } 
 else{
    #>> Если нет, то запускает сканирование.
     my $ok = $self->{cb}->launch();
     my $error = $self->{cb}->error;
     my $t;
     $t .= Tr(td([ "Запуск", "произведен" ]));
     $t .= Tr(td([ "Ошибки:", $error||"Нет" ]));
     $t = table({-border=>1},$t);
     $rv = $t;
 }     
}

sub news_url{
 my $self = shift;
 $self->{p}{news_id} +=0 or die "news_id!";
 my $sth = $self->{cb}->find( table=>"news", where=>"news_id=$self->{p}{news_id}");
 my $r = $sth->fetchrow_hashref() or die "not found news_id=$self->{p}{news_id}";
 return "$r->{site}/$r->{url}";
}

sub delete_old{
 # useage 
 # my $months_will_delete = $self->delete_old( only_get_mon=>1 );
 # my $recs_will_delete = $self->delete_old( only_get_records=>1 );
 # my $records_was_deleted = $self->delete_old();
 my $self = shift;
 my %pars = @_;
 my $cb = $self->{cb} or die "cb!";
 my $rv;
 my $mon = $cb->{conf}{delete_month_old}+=0; 
# die $pars{html};
 $mon = 12 if $mon < 1; 
 if ( $pars{only_get_mon} ){
    if ( $pars{html} ){
        return table({border=>0}, 
	    Tr(td(
		a({-href=>$self->url( only_get_records=>1, default=>[ "screen", "action" ] )},"Удаление записей, старших чем $mon месяцев")
	    ))
	);
    }
    else{ # without html, only digit:
	return $mon;
    }
 }    
 my ( $y, $m, ) = $cb->my_date() or die "my date!";
 $m -= $mon;
 $m+=12, $y-=1 while $m<1;
 
 my $old_date = $cb->my_date($y,$m,"01","00","00","00");
 
# die Dumper $old_date;

 my $sth1 = $cb->find( sql=>"SELECT news_id FROM news WHERE who_take ='' AND datetime < $old_date" ) or die "Error:".$cb->error;
 my $sql2 = "DELETE FROM news WHERE news_id=?";
 my $sql3 = "DELETE FROM news_ips_read WHERE news_id=?";
 my $cnt;
 while ( my ($r) = $sth1->fetchrow_array ){
    $cnt++;
    next if $pars{only_get_records};
    $cb->do_sql( sql=>$sql3, bind_values=>[ $r ] ) or die $cb->error;
    $cb->do_sql( sql=>$sql2, bind_values=>[ $r ] ) or die $cb->error;
 }
 $cnt +=0;
 # $cnt records was deleted

 if ( $pars{only_get_records} ){
    if ( $pars{html} ){
	return table({border=>0}, 
	    Tr(td(
		a({-href=>$self->url( default=>[ "screen", "action" ] )},"Удалить $cnt записей!")
	    ))
	);
    }
    else{ # without html:
	return $cnt;
    
    }
 }     
 
 if ( $cnt ){
    # save in stat:
    $cb->do_sql( sql=>"DELETE FROM stat WHERE name_en like '%clear_database%'" );
    $cb->set_stat( name_en=>"clear_database", name_ru=>"Очистка базы данных", val=>"$cnt", 
	comment=>"Старше чем $mon мес. $self->{user_ip}");
 }
 
 $self->{error} = "0 records was deleted." if !$cnt; 
 if ( $pars{html} ){ # with html:
     $rv = table({-border=>0},Tr(td("Удалено $cnt записей")));
 }
 else{ # without html:
    return $cnt;
 }
}

sub userdoc{
 my $self = shift;
 my %pars = @_;
 my %p = %{ $self->{p} };
 my $action = $pars{action};
 my $udd = $self->{cb}{conf}{userdoc_dir}||""; #user doc dir
 my $ddd = $self->{cb}{conf}{developerdoc_dir}||""; #developer doc dir

 my $rv;
 if ( $p{img} ){
    # запрос на картинку:
    my $f = $p{img} or die "img!";
    $f = "$udd/$f";
    die "file '$f' not found " if ! -e $f;
    open F, $f or return "$! $f";
    binmode F;
    $rv .= $_ while <F>;
    close F;
    return $rv;
 }

 my $ud_file = "$udd/content";
 open CONTENT, $ud_file or return "$! $ud_file";
 my $t;
 my $cur_text; my $ctt;
 while ( my $l = <CONTENT> ){
    # содержание:
     my %cl = (-class=>"menu");
    chomp $l;
    my ( $en, $ru ) = split /\|/, $l;
    if ( $en eq $action ){
	%cl = (-class=>"menu current");
	
	if ( $en =~/\.pm/ ){
	    my $cf = "$ddd/$en";
	    $cur_text = $self->pm2doc(f=>$cf) || $self->error;
	}else{
	    my $cf = "$udd/$en";
	    $cur_text = $self->txt2doc(f=>$cf) || $self->error;
	}    
	$cur_text = "<u><b>$ru</b></u><br><br>$cur_text";
    }

    my $an = a( { %cl ,-href=>$self->url( screen=>"userdoc", action=>$en,  default=>[qw//] ) },$ru );
    $t .= Tr(td({%cl},$an));
 }
 $ctt .= table({-border=>0},Tr(td({-class=>"doc"}, $cur_text ))) if $cur_text; 
 close CONTENT;
 $t = table({-border=>0},$t);
 $rv .= $t.$ctt.( $ctt ? $t : "");
 return $rv;
}

sub txt2doc{
 my $self = shift;
 my %pars = @_;
 my %p = %{ $self->{p} };
 my $cf = $pars{f} or $self->{error} = "f!", return 0;
 open TEXT, $cf or return "$! $cf";
 local $/ = '';
 my $rv='';
 while ( my $tl = <TEXT> ){
    chomp $tl;
    $tl .= "<BR><BR>";
    $tl =~ s/(\w+\.gif|\w+\.jpeg|\w+\.jpg|\w+\.bmp)/<IMG SRC="?screen=$p{screen}&action=$p{action}&img=$1">/gism;
    $tl =~s/(.*)\#(.*)/$1<font color = "grey">\#$2<\/font>/;
    $rv .= $tl;
 }
 close TEXT;
 return $rv; 
}

sub pm2doc{
 my $self = shift;
 my %pars = @_;
 my $f = $pars{f} or $self->{error} = "f!", return 0;
 open TEXT, $f or return "$! $f";
# local $/ = '';
 my $rv='';
 while ( my $tl = <TEXT> ){
    chomp $tl;
    my ($format, $doc, $sub) = $tl =~/\#\>([i|u|c|b|s]?)\s*(.*)|(sub\s+\w+)/;
    #$doc =~ s/(sub\s+\w+)/\<b\>$1\<\/b\>/;
    $rv .= "<br><b>$sub</b><br>" if $sub;
    if ( $doc ){
	$rv .= "$doc<br>" if !$format or $format eq "#";
	$rv .= "<$format>$doc</$format><br>" if $format and $format ne "c";
	$rv .= "<code>$doc</code><br>" if $format and $format eq "c";
	
    }	
 }
 close TEXT;
 return $rv; 
}

1;


